perm filename JUSTFY.F4[NEW,LCS]15 blob
sn#502572 filedate 1980-04-20 generic text, type T, neo UTF8
00100 C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
00200 SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00300 COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00400 DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
00500 DATA RBX/6.0/,RBZ/8.0/,SPFAC/0.20/
00600 DO 11 KN=0,JLP
00700 RSPC=0
00800 R8=KN
00900 N=0
01000
01100 DO 2 K=1,KY
01200 L=NP(K)
01300 RL=RN(L)
01400 C RL=WDCNT-2
01500 RA=RN(L+1)
01600 C RA=CODE NUM.
01700 RB=RN(L+3)
01800 C RB=POSITION(P3)
01900 IF(RN(L+2).EQ.R8)GO TO 77
02000 C THIS STAFF?
02100 IF(RA.NE.4)GO TO 2
02200 C SKIPS HOMED NOTES (IN CHORDS)
02300 77 IF(RA.LT.3)GO TO 20
02400 IF(RA.EQ.4)GO TO 444
02500 IF(RA.EQ.3)GO TO 333
02600 C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
02700 C*** CAN'T WORK YET ***** IF(RA.LT.16)GO TO 2
02800 IF(RA.LT.17)GO TO 2
02900 GO TO 10
03000 333 IF(RL.LT.3)GO TO 10
03100 C <3 MEANS NOTHING IN P5
03200 IF(RN(L+5).GT.4)GO TO 2
03300 C NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
03400 GO TO 10
03500 444 IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 2
03600 C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
03700 CC FOR REPEAT BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
03800 C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
03900 GO TO 10
04000 20 IF(RA.NE.2)GO TO 113
04100 C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
04200 IF(RN(L+6))GO TO 2
04300 IF(RN(L+7))GO TO 2
04400 C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
04500 GO TO 10
04600 113 IF(RL.LT.7)GO TO 10
04700 C NOW NOTES. SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
04800 IF(RN(L+9).LT.0)GO TO 2
04900 10 N=N+1
05000 R(1,N)=RB
05100 IR(2,N)=L
05200 IF(N.EQ.250)GO TO 28
05300 C ONLY TREATS 250 ITEMS AT A TIME.
05400 2 CONTINUE
05500
05600 IF(N.EQ.0)GO TO 11
05700 28 DO 23 K=1,N
05800 23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
05900 C SKIPS IF ONLY BAR LINES ON THIS STAFF
06000 GO TO 11
06100 24 RSZ=RSTFAC(KN)*PRCNT
06200 CALL SORT2(R,N)
06300
06400 C JUMP IF LAST IS A BAR LINE.
06500 K=0
06600 JLDGR=0
06700 JX=0
06800 22 K=K+1
06900 122 L=IR(2,K)
07000 RA=RN(L+1)
07100 C RA IS NOW CODE NUM.
07200 RL=RN(L)
07300 C RL=WDCNT-2
07400 RB=0
07500 RD=0
07600 C RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
07700 RX=RN(L+5)
07800 C RX=PARAM 5
07900 RX6=RN(L+6)
08000 RY=1
08100 RW=AMOD(RN(L+4),100.)
08200 RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
08300 IF(RA.GT.1)GO TO 4
08400 RZ=RN(L+7)
08500 IF(LDGR.NE.JLDGR)JLDGR=0
08600 C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
08700 LDGR=0
08800 JK=K
08900 DO 32 JJ=JK+1,N+1
09000 K=JJ
09100 RB=R(1,JJ)-R(1,JJ-1)
09200 IF(RB.GT.0.1)GO TO 320
09300 C PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
09400 R(1,JJ)=R(1,JJ-1)
09500 GO TO 32
09600 320 IF(RB.GT.RSP)GO TO 35
09700 32 CONTINUE
09800 C FOUND HOW MANY MEMBERS TO CHORD.
09900 35 RB=0
10000 K=K-1
10100 RQ=0
10200 125 RC=ABS(RN(L+4))
10300
10400 IF(RC.LT.60)GO TO 637
10500 IF(RC.LT.180)RY=.6
10600 C FOUND A MINI-NOTE
10700
10800 637 RSDF=0
10900 IF(RA.EQ.1)GO TO 437
11000 C JUMP IF NOTE
11100 RDF=-1
11200 C NOW IT'S ANYTHING BUT A NOTE
11300 GO TO 137
11400 437 IF(RL.LT.8)GO TO 237
11500 C JUMP IF THERE IS NOT P10 TO LOOK AT
11600 RW=RN(L+10)
11700 C PUT P10 INTO RW
11800 GO TO 337
11900 237 RW=0
12000 337 IF(RDF.LT.0)GO TO 537
12100 C JUMP IF PREVIOUS WAS NOT A NOTE
12200 IF(RW.EQ.RDF)GO TO 137
12300 C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
12400 RSDF=-1
12500 537 RDF=RW
12600 C SAVE STAFF INFO FOR NEXT TIME AROUND.
12700
12800 137 DO 37 JJ=JK,K
12900 C******* IF(RD.NE.0)GO TO 38
13000 C FINDS ONLY HIGH OR! LOW LED. LINE.
13100 JR=IR(2,JJ)
13200 RW=AMOD(RN(JR+4),100.)
13300 IF(RW.GT.12)GO TO 277
13400 IF(RW.GE.2)GO TO 38
13500 277 LDGR=-1
13600 IF(RW.GT.11)LDGR=1
13700 IF(JLDGR.EQ.LDGR)GO TO 36
13800 JLDGR=LDGR
13900 C LDGR IS FOR LEDGER LINES.
14000 GO TO 38
14100 36 IF(RD.GE.1.5)GO TO 38
14200 RD=1.5
14300 RQ=RD
14400 38 IF(RB.GT.2)GO TO 222
14500 C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
14600 RZZ=RN(JR+7)
14700 RE=RN(JR+5)
14800 IF(RB.GE.2)GO TO 477
14900 RC=1.5
15000 IF(RZZ.LT.10)GO TO 378
15100 IF(RZZ.GE.20)RC=3.
15200 C 10=DOT, 20=DOUBLE DOT
15300 GO TO 377
15400 378 IF(RE.GE.20)GO TO 477
15500 IF(AMOD(RZZ,10.).EQ.0)GO TO 477
15600 377 RB=RC+EXTEN(RZZ)
15700 C SPACE FOR DOT OR TAIL(IF STEM UP)
15800 477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
15900 C FOR CHORD TONES ON RIGHT OF STEM UP.
16000 C LOOKS THROUGH ALL NOTES OF A CHORD.
16100 222 RC=AMOD(RE,10.0)
16200 IF(RC.EQ.0)GO TO 37
16300 C JUMP IF NO ACCIS. NOW SEE IF THERE'S SPACE FOR ACCI.
16400 IF(RN(JIR+1).NE.1)GO TO 425
16500 C* RX=0
16600 C* IF(RN(JR).GE.8)RX=RN(JR+10)
16700 C* RXX=0
16800 C* IF(RN(JIR).GE.8)RXX=RN(JIR+10)
16900 C* RDF=0
17000 C* IF(RX.NE.RXX)RDF=100.
17100 C SAVE INFO ON NOTES ON DIFF. STAVES.
17200 C* IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
17300 C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
17400 C JIR IS POINTER TO PREVIOUS ITEM. SKIP IF NOT A NOTE.
17500 KX=RC
17600 C KX=ACCI ON CURRENT NOTE
17700 RD=1
17800 C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
17900 RX=RN(L+4)
18000 RXX=ABS(RX)
18100 C THIS NOTE
18200 577 IF(RXX.LT.80)GO TO 677
18300 C FIND MINIS, HARMONICS, ETC.
18400 RXX=RXX-100
18500 GO TO 577
18600 677 IF(RX)RXX=-RXX
18700 RX=RXX
18800 RDIF=RN(JIR+4)
18900 RXX=ABS(RDIF)
19000 777 IF(RXX.LT.80)GO TO 877
19100 C FIND MINIS, HARMONICS, ETC.
19200 RXX=RXX-100
19300 GO TO 777
19400 877 IF(RDIF)RXX=-RXX
19500
19600 RDIF=RX-RXX
19700 C HEIGHT DIFF. JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
19800 RX=3
19900 JSTM=RN(JIR+5)/10.0
20000 C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
20100 IF(RDIF.GT.0)GO TO 427
20200 C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
20300 IF(JSTM.NE.2)GO TO 424
20400 IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
20500 C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL. THEN WE NEED SPACE.
20600 424 IF(KX.NE.2)RX=5
20700 GO TO 428
20800 427 IF(KX.EQ.2)RX=4
20900 C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
21000 428 IF(ABS(RDIF).LT.RX)GO TO 425
21100 IF(RDIF)GO TO 426
21200 C JUMP IF THIS NOTE IS LOWER THAN PREV.
21300 IF(JSTM.NE.1)GO TO 426
21400 C NO BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.
21500
21600 425 RW=2.8
21700 IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
21800 CATCHES DOUBLE FLAT (=4)
21900 RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
22000 CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425 RD=2*RY+EXTEN(RE)
22100 426 IF(RQ.GT.RD)RD=RQ
22200 RQ=RD
22300 C FUNCT. EXTEN=AMOD(X,1.)*10.
22400 37 CONTINUE
22500
22600 IF(RY.NE.1)RB=RB-.5*RJSZ
22700 C MINI NOTES NEED LESS SPACE
22800 250 IF(RSDF)GO TO 17
22900 ACCX=0
23000 CC RC=0
23100 JIR=JX+2
23200 IF(JIR.GE.N)GO TO 25
23300 RW=R(1,JIR-1)
23400
23500 DO 132 JJ=JIR,N
23600 IF(RW.NE.R(1,JJ))GO TO 25
23700 KX=IR(2,JJ)
23800 C GET POINTER
23900 IF(RN(KX+1).NE.1)GO TO 25
24000 C ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
24100 CC RE=ABS(RN(KX+6))
24200 CC IF(RE.GE.10)RC=-2.6
24300 CC IF(RE.EQ.20)RC=-RC
24400 RC=OTHSID(RN,KX)
24500 RE=AMOD(RN(KX+5),10.0)
24600 C FIND AN ACCI
24700 IF(RE.GE.1)RC=RC+2
24800 IF(IFIX(RE).EQ.4)RC=RC+2
24900 C FOUND AN ACCI RE=4=DOUBLE FLAT
25000 RC=AMOD(RE,1.0)*10.0+RC
25100 C ADD ANY EXTENSION TO THE LEFT
25200 IF(RC.GT.ACCX)ACCX=RC
25300 CC RC=0
25400 IF(ACCX.GT.RD)RD=ACCX
25500 132 CONTINUE
25600 GO TO 25
25700
25800 4 IF(RA.NE.2)GO TO 33
25900 C NEXT FOR DOTTED RESTS - IN P6
26000 IF(RL.GE.4)RB=RN(L+6)*1.5
26100 C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
26200 GO TO 250
26300 33 IF(RA.NE.3)GO TO 29
26400 RB=3
26500 IF(RN(L+4).GT.80)RB=1.5
26600 C CHECK ON SIZE NEEDED FOR CLEFS. >80 = MINICLEF
26700 29 IF(RA.NE.4)GO TO 26
26800 C BAR LINES
26900 IF(RN(L+4).LT.0)GO TO 17
27000 C SKIP IF INVISIBLE BAR LINE (FOR PAGE PROGRAM )
27100 RB=-RJSZ/2
27200 RD=.9
27300 KX=RN(L+4)/1000.
27400 IF(KX.LE.0.)GO TO 25
27500 RD=RD+1.2
27600 C ADD A LITTLE SPACE IN FRONT OF DBL BAR.
27700 IF(KX.GT.1)GO TO 229
27800 IF(RL.LT.3)GO TO 25
27900 C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN P5.
28000 CCC IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
28100 229 IF(KX.NE.2)RD=RD+RD
28200 C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
28300 C REPT BAR WITH DOTS TO LEFT. ADD SPACE IN FRONT OF IT.
28400 RB=-RB/RBX
28500 IF(KX.EQ.4)KX=0
28600 129 IF(KX.GE.2)RB=RBZ*RB
28700 C IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
28800 GO TO 25
28900
29000 26 IF(RA.NE.18)GO TO 30
29100 C METER
29200 RC=0
29300 IF(RL.GE.7)RC=9
29400 C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
29500 RB=-1
29600 RD=1
29700 IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
29800 C CHECKS FOR 2-DIGIT METERS
29900 RD=2
30000 RB=0
30100 31 RB=RB+RC
30200 GO TO 25
30300 30 IF(RA.NE.17)GO TO 17
30400 C30 IF(RA.NE.16)GO TO 34
30500 C IF(RL.GE.8.0)GO TO 3 ***THIS NEXT CAN'T WORK YET ****
30600 C P10 MUST =0 *** BECAUSE NO INFO IN P9 WITH SHORT GROUPS ***
30700 C RC=R(1,N)
30800 C P3 POSITION
30900 C KY=L
31000 C RX=0
31100 C DO 134 KX=1,N
31200 C L=IR(2,KX)
31300 C IF(RN(L+1).NE.16.0)GO TO 134
31400 C SKIP IF NEXT IS NOT WORD
31500 C RW=0
31600 C IF(RC.LE.RN(L+3))GO TO 134
31700 C SKIP IF WORD IS TO RIGHT OF NEXT WORD
31800 C334 RW=RW+RN(KY+9)
31900 C UPDATE SPACE NEEDED (IN P9)
32000 C IF(RN(KY+10).NE.16.0)GO TO 234
32100 C JUMP OUT IS NEXT IS NOT WORD
32200 C KY=KY+9
32300 C IF(RN(KY).LE.7.0)GO TO 234
32400 C JUMP OUT IF NEXT STARTS NEW GROUP OF CHARS.
32500 C KY=KY+1
32600 C GO TO 334
32700 C234 RW=RN(L+3)+RW*RSZ
32800 C NOW RW GIVES END POINT OF GROUP
32900 C IF(RW.GT.RX)RX=RW
33000 C RX IS POINT FOR COMPARISON (CAN OVERLAP)
33100 C134 CONTINUE
33200 C IF(RX.EQ.0.OR.RC-RX.GE.RSP)GO TO 3
33300 C GO TO 3 IF ENOUGH SPACE ALREADY
33400 C GO TO 25
33500 C34 IF(RA.NE.17)GO TO 17
33600 C KSIG
33700 RX=ABS(RX)
33800 IF(RX.GE.100)RX=RX-100
33900 C +100 FOR NATURALS AS KEYSIG.
34000 RB=2*(RX-1)-2
34100 C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
34200 RD=2
34300 25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
34400 17 RC=(RB+RJSZ)*RSZ
34500 C RJSZ=DEFAULT SIZE
34600 JIR=L
34700 C SAVE THE POINTER FOR ACCI. CHECK AT 110
34800 JX=K
34900 R(2,JX)=RC
35000 3 IF(K.LT.N)GO TO 22
35100 RA=R(1,1)
35200 RB=R(2,1)
35300
35400 DO 13 KX=2,JX
35500 RE=R(1,KX)
35600 C POS. BEFORE SHIFTING
35700 IF(ABS(RE-RA).GT.RSP)GO TO 14
35800 CCC IF(ABS(RE-RA).GT..5)GO TO 14
35900 IF(R(2,KX).GT.RB)GO TO 16
36000 C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
36100 GO TO 13
36200 C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
36300 14 RD=RA+RB-RE
36400 IF(RD.LE.0)GO TO 16
36500 C THERE'S ENOUGH ROOM
36600 ROV=ROV+RD
36700 140 R4=RE+RSPC-.001
36800 R5=10000
36900 R8=RD
37000 R9=0
37100 C GO EXPAND IT
37200 IF(R(2,KX).EQ.0)GO TO 15
37300 CALL MOVIT(RN,NO,R4,R5,R8,R9)
37400 C???? IF(R2.LE.4)GO TO 15
37500 C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
37600 IF(R2.LE.7)GO TO 15
37700 R5=R4
37800 R4=RA+.001+RSPC
37900 R8=R4
38000 R9=R5+RD-.001
38100 C FOR ITEMS ON OTHER LINES.
38200 CALL MOVIT(RN,NO,R4,R5,R8,R9)
38300 15 RSPC=RSPC+RD
38400 C RSPC SAVES TOTAL SPACE ADDED
38500 16 RB=R(2,KX)
38600 13 RA=RE
38700 11 CONTINUE
38800 END
38900
39000 FUNCTION OTHSID(RN,J)
39100 DIMENSION RN(1)
39200 OTHSID=0
39300 A=ABS(RN(J+6))
39400 IF(A.GE.10)OTHSID=-2.6
39500 C OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
39600 IF(A.GE.20)OTHSID=-OTHSID
39700 END